home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / DATABASE / MAKEMRG.ZIP;1 / MAKEMRG.PRG < prev    next >
Encoding:
Text File  |  1993-03-07  |  8.1 KB  |  281 lines
  1. * PROGRAM...........MAKEMRG.PRG Version 1.0 (Initial Release)
  2. * NOTES.............WILL CREATE A WordPerfect 5.1 MERGE FILE FROM ANY DATABASE
  3. *                   BY SELECTING FIELDS FROM A LIST AND THEN SETTING UP A CRUDE
  4. *                   FILTER AND THEN SETTING AN INDEX.  MAXIMUM NUMBER OF FIELDS
  5. *                   THAT CAN BE DISPLAYED IS 64.
  6. * AUTHOR............MICHAEL A. HUBER
  7. * DATE..............03/02/93
  8.  
  9.  
  10. ON ERROR DO Bad
  11. SET TALK OFF
  12. SET SAFETY OFF
  13. CLEAR ALL
  14. CLEAR
  15. DEFINE WINDOW m_ERROR FROM 10,15 TO 14,65
  16. @ 1,0
  17. ?? REPLICATE(CHR(205),79)
  18. TEXT
  19.      Program: MAKEMRG.PRG  Version 1.0  (Initial Release)
  20.  
  21.       Author: Michael A. Huber
  22.               P.O. Box 501511
  23.               Indianapolis, IN  46250-6511
  24.  
  25.        Notes: Creates a WordPerfect 5.1 merge file (MERGE.DAT) using 
  26.               up to 64 fields from a dBASE IV database.  Also allows 
  27.               filtering of records, creating an index, convert the 
  28.               character fields to proper case and defining where
  29.               the output merge file will be located.
  30.  
  31. Requirements: WordPerfect 5.1 (Convert.Exe) - Trademark of WordPerfect Corp.
  32.               dBASE IV                      - Trademark of Borland
  33.  
  34. You may use this program and copy it freely among your friends or business 
  35. associates.  All I ask is that you do not remove this title screen from any
  36. copy you make and if you find the program useful send a donation of $10.00
  37. to me at the above address.  A User Defined Function called PROPER() is 
  38. located at the end of this program and is very useful even by itself. 
  39. ENDTEXT
  40. ? REPLICATE(CHR(205),79)
  41. @ 24,37 SAY "........"
  42. @ 24,57 SAY "(ENTER) To Quit"
  43. @ 23,0
  44. ACCEPT 'Database Filename Without Extension: ' TO m_FILE
  45. USE &m_FILE
  46. IF FILE(m_FILE+".DBF")=.T.
  47.  STORE 1 TO m_FIELD
  48.  STORE 0 TO m_COLUMN
  49.  STORE 2 TO m_ROW
  50.  CLEAR
  51.  @ 0,0 SAY "Structure For: "+UPPER(m_FILE)+".DBF"
  52.  @ 1,0 
  53.  ?? REPLICATE(CHR(205),79)
  54.  DO WHILE m_FIELD <= FLDCOUNT().AND.m_FIELD<=64
  55.   @ m_ROW,m_COLUMN SAY STR(m_FIELD,2)+"--> "+TRIM(FIELD(m_FIELD)) 
  56.   m_ROW=m_ROW+1
  57.   IF m_ROW=18
  58.    STORE M_COLUMN+20 TO m_COLUMN
  59.    m_ROW=2
  60.   ENDIF
  61.   m_FIELD=m_FIELD+1
  62.  ENDDO
  63.  @ 18,0
  64.  ?? REPLICATE(CHR(205),79)
  65.  STORE 0 TO m_CHOICE
  66.  STORE "" TO m_LIST
  67.  SET BELL OFF
  68.  @ 24,45 SAY "(ESC) To Process Field List"
  69.  SET ESCAPE ON
  70.  DO WHILE LASTKEY()<>27
  71.   @ 24,1 SAY "Choose A Field Number: " GET m_CHOICE PICT "99"
  72.   READ
  73.   IF m_CHOICE >0 .AND. m_CHOICE<=FLDCOUNT();
  74.     .AND. .NOT. FIELD(m_CHOICE) $ m_LIST;
  75.     .AND. .NOT. FIELD(m_CHOICE)+"," $ m_LIST;
  76.     .AND. .NOT. ","+FIELD(m_CHOICE) $ m_LIST
  77.    IF LEN(m_LIST)+LEN(FIELD(m_CHOICE))+1<250
  78.     IF LEN(m_LIST)=0
  79.      STORE "COPY TO MERGE.DBF FIELDS "+m_LIST+FIELD(m_CHOICE) TO m_LIST
  80.     ELSE
  81.      STORE m_LIST+","+FIELD(m_CHOICE) TO m_LIST
  82.     ENDIF
  83.     @ 20,0 SAY m_LIST
  84.    ELSE
  85.     DO WHILE LASTKEY()<>99 .AND. LASTKEY()<>67
  86.      ACTIVATE WINDOW m_ERROR
  87.      @ 2,5 SAY "Field list to long - Press (C)ontinue"
  88.      WAIT "" TO CONTINUE
  89.      CLEAR
  90.     ENDDO
  91.     DEACTIVATE WINDOW m_ERROR
  92.    ENDIF 
  93.   ENDIF
  94.   m_CHOICE=0
  95.  ENDDO 
  96.  STORE "SET FILTER TO " TO m_FILTER
  97.  @ 19,0 CLEAR TO 24,79
  98.  STORE FIELD(1) TO m_EX1
  99.  STORE FIELD(2) TO m_EX2
  100.  @ 20,0 SAY 'Example: '+TRIM(m_EX1)+'='+;
  101.    IIF(TYPE(m_EX1)='C','"'+TRIM(&m_EX1)+'"',;
  102.    IIF(TYPE(m_EX1)='N',LTRIM(STR(&m_EX1)),;
  103.    IIF(TYPE(m_EX1)='D','CTOD("'+DTOC(&m_EX1)+'")',;
  104.    IIF(TYPE(m_EX1)='L',".T."," "))))+' .AND. '+TRIM(m_EX2)+'='+;
  105.    IIF(TYPE(m_EX2)='C','"'+TRIM(&m_EX2)+'"',;
  106.    IIF(TYPE(m_EX2)='N',LTRIM(STR(&m_EX2)),;
  107.    IIF(TYPE(m_EX2)='D','CTOD("'+DTOC(&m_EX2)+'")',;
  108.    IIF(TYPE(m_EX2)='L',".T."," "))))
  109.  @ 23,53 SAY "(ESC)   To Quit"
  110.  @ 24,16 SAY "...................................."
  111.  @ 24,53 SAY "(ENTER) To Process Filter"
  112.  @ 23,79 
  113.  SET ESCAPE OFF
  114.  ACCEPT "Filter Command: " TO m_COMMAND
  115.  STORE m_FILTER+m_COMMAND TO m_FILTER
  116.  SET ESCAPE ON
  117.  IF LASTKEY()<>27
  118.   STORE "INDEX ON " TO m_INDEX
  119.   STORE " TO TEMP.NDX" TO m_INDEX1
  120.   @ 19,0 CLEAR TO 24,79
  121.   @ 20,0 SAY 'Example: '+;
  122.     IIF(TYPE(m_EX1)='N','STR('+TRIM(m_EX1)+')+',;
  123.     IIF(TYPE(m_EX1)='C','TRIM('+TRIM(m_EX1)+')+',;
  124.     IIF(TYPE(m_EX1)='D','DTOC('+TRIM(m_EX1)+')+'," ")))+;
  125.     IIF(TYPE(m_EX2)='N','STR('+TRIM(m_EX2)+')',;
  126.     IIF(TYPE(m_EX2)='C','TRIM('+TRIM(m_EX2)+')',;
  127.     IIF(TYPE(m_EX2)='D','DTOC('+TRIM(m_EX2)+')'," ")))
  128.   @ 23,53 SAY "(ESC)   To Quit"
  129.   @ 24,16 SAY "...................................."
  130.   @ 24,53 SAY "(ENTER) To Process Index"
  131.   @ 23,79 
  132.   SET ESCAPE OFF
  133.   ACCEPT "Index Statement: " TO m_COMMAND
  134.   @ 24,0 CLEAR TO 24,79
  135.   IF LASTKEY()<>27
  136.    IF m_COMMAND > " "
  137.     STORE m_INDEX+m_COMMAND+m_INDEX1 TO m_INDEX
  138.    ELSE
  139.     STORE " " TO m_INDEX
  140.    ENDIF
  141.    SET ESCAPE ON
  142.    STORE HOME() TO m_PATH
  143.    @ 19,0 CLEAR TO 24,79
  144.    @ 20,0 SAY "Current Path: "+m_PATH
  145.    @ 23,57 SAY "(ESC)     To Quit"
  146.    @ 24,33 SAY "......................"
  147.    @ 24,57 SAY "(ENTER) = Current Path"
  148.    @ 23,79
  149.    SET ESCAPE OFF
  150.    ACCEPT "Put MERGE.DAT In What Directory? " TO m_PATH 
  151.    IF m_PATH=" "
  152.     STORE HOME() TO m_PATH
  153.    ELSE
  154.     IF SUBSTR(m_PATH,LEN(m_PATH),1) <> "\"
  155.      STORE m_PATH+"\" TO m_PATH 
  156.     ENDIF
  157.    ENDIF
  158.    SET ESCAPE ON
  159.    @ 20,0 CLEAR TO 24,79
  160.    IF LASTKEY()<>27 
  161.     SET BELL ON
  162.     @ 20,0 CLEAR TO 20,79
  163.     IF m_INDEX > " "
  164.     @ 20,0 SAY "PLEASE WAIT - Indexing Database Records"
  165.      &m_INDEX
  166.     ENDIF
  167.     @ 21,0 CLEAR TO 21,79
  168.     @ 21,0 SAY "PLEASE WAIT - Processing Database Records"
  169.     &m_FILTER
  170.     &m_LIST
  171.     USE MERGE.DBF
  172.     STORE 1 TO m_FIELD
  173.     DO WHILE m_FIELD <= FLDCOUNT()
  174.      IF TYPE(FIELD(m_FIELD)) = 'C' .AND. FIELD(m_FIELD)<>'STATE'
  175.       @ 22,0 CLEAR TO 22,79
  176.       @ 22,0 SAY "PLEASE WAIT - Converting "+TRIM(FIELD(m_FIELD))+;
  177.         " To Correct Case Using PROPER() U.D.F."
  178.       STORE FIELD(m_FIELD) TO m_FIELD1
  179.       REPLACE ALL &m_FIELD1 WITH PROPER(&m_FIELD1)
  180.      ENDIF
  181.      m_FIELD=m_FIELD+1
  182.     ENDDO
  183.     @ 23,0 CLEAR TO 23,79
  184.     @ 23,0 SAY "PLEASE WAIT - Converting Merge File"
  185.     COPY TO MERGE.DIF TYPE DIF
  186.     STORE m_PATH+"MERGE.DAT" TO m_ERASE
  187.     ERASE m_ERASE
  188.     STORE "RUN C:\WP51\CONVERT MERGE.DIF "+m_PATH+"MERGE.DAT A" TO m_MRGSTR
  189.     @ 20,0 CLEAR TO 24,79
  190.     @ 23,0
  191.     &m_MRGSTR
  192.     IF FILE(m_PATH+"MERGE.DAT")=.T.
  193.      DO Ok
  194.     ELSE
  195.      DO Bad
  196.     ENDIF
  197.     CLEAR ALL
  198.     ERASE MERGE.DBF
  199.     ERASE MERGE.DIF
  200.     ERASE TEMP.NDX
  201.    ENDIF
  202.   ENDIF
  203.  ENDIF
  204. ENDIF
  205. ON ERROR
  206. SET SAFETY ON
  207. SET TALK ON
  208. CLEAR ALL
  209. CLEAR
  210.  
  211.  
  212. PROCEDURE Ok
  213. CLEAR
  214. @ 6,0
  215. ?? REPLICATE(CHR(205),79)
  216. TEXT 
  217.  
  218.  
  219.                   *******************************************
  220.                   **********  MERGE FILE CREATED  ***********
  221.                   *******************************************
  222.                         MAKEMRG.PRG by Michael A. Huber
  223.                   P.O. Box 501511, Indianapolis,IN 46250-6511
  224.  
  225.  
  226.  
  227. ENDTEXT
  228. ? REPLICATE(CHR(205),79)
  229. WAIT
  230.  
  231.  
  232. PROCEDURE Bad
  233. IF ERROR()=62
  234.  RETURN
  235. ENDIF
  236. CLEAR
  237. @ 6,0
  238. ?? REPLICATE(CHR(205),79)
  239. TEXT
  240.  
  241.  
  242.                   *******************************************
  243.                   **********  MERGE FILE CREATION  **********
  244.                   **********        FAILED         **********
  245.                   ******************************************* 
  246.                         MAKEMRG.PRG by Michael A. Huber
  247.                   P.O. Box 501511, Indianapolis,IN 46250-6511
  248.  
  249.  
  250. ENDTEXT
  251. ? REPLICATE(CHR(205),79)
  252. ?
  253. @ ROW(),INT((80-LEN('ERROR NO. '+LTRIM(STR(ERROR(),4))+'  '+MESSAGE()))/2) SAY;
  254.   'ERROR NO. '+LTRIM(STR(ERROR(),4))+'  '+MESSAGE()
  255. ON ERROR
  256. CLEAR ALL
  257. ERASE MERGE.DBF
  258. ERASE MERGE.DIF
  259. ERASE TEMP.NDX
  260. SET SAFETY ON
  261. SET TALK ON
  262. CANCEL
  263.  
  264.  
  265. FUNCTION Proper
  266. PARAMETERS m_str
  267. STORE UPPER(SUBSTR(m_str,1,1)) TO m_str1
  268. STORE 2 TO m_pos
  269. DO WHILE m_pos<=LEN(TRIM(m_str))
  270.  IF SUBSTR(m_str,m_pos-1,1) <> " ".AND.SUBSTR(m_str,m_pos-1,1) <> ".";
  271.   .AND.SUBSTR(m_str,m_pos-1,1) <> "'".AND.SUBSTR(m_str,m_pos-1,1) <> ",";
  272.   .AND.SUBSTR(m_str,m_pos-1,1) <> "-".AND.UPPER(SUBSTR(m_str,m_pos-2,2)) <> "MC"
  273.   STORE m_str1+LOWER(SUBSTR(m_str,m_pos,1)) TO m_str1
  274.  ELSE 
  275.   STORE m_str1+UPPER(SUBSTR(m_str,m_pos,1)) TO m_str1
  276.  ENDIF
  277.  STORE m_pos+1 TO m_pos
  278. ENDDO
  279. STORE m_str1 TO m_str
  280. RETURN m_str
  281.